home *** CD-ROM | disk | FTP | other *** search
/ Atari Mega Archive 1 / Atari Mega Archive - Volume 1.iso / tex / td187src.lzh / COMPILE.I < prev    next >
Text File  |  1991-12-14  |  43KB  |  1,311 lines
  1. IMPLEMENTATION MODULE Compile ;
  2.  
  3. (* Erweitert um Beziercurve,    JP *)
  4. (* Erweitert um Epic-Kommandos, JP *)
  5.  
  6. FROM Dialoge   IMPORT BusyStart, BusyEnd;
  7. FROM FileIO    IMPORT Rewrite, Close, WriteLn;
  8. FROM File      IMPORT InsertFile;
  9. FROM CSspecial IMPORT WriteCSspecial;
  10. FROM Types     IMPORT TextPosTyp, DrawObjectTyp, ObjectSet,
  11.                       LatexSpecials,
  12.                       ObjectPtrTyp, specialformat;
  13. IMPORT CommonData ;
  14. IMPORT Diverses ;
  15. IMPORT GetFile;
  16. IMPORT ObjectUtilities ;
  17. IMPORT MagicStrings;
  18. IMPORT MagicSys;
  19. IMPORT Variablen ;
  20. IMPORT MathLib0 ;
  21.  
  22. (**
  23. IMPORT Debug;
  24. **)
  25.  
  26. (* Index 1 und 2 bezeichen immer den Referenzpunkt                         *)
  27. (* Index 8 zumeist die Liniendicke, Index 9 die Textlänge so vorhanden     *)
  28. (*      0         |   3    |   4   |   5   |   6   |   7   |   8   |   9   *)
  29. (* ---------------+--------+-------+---------------+-------+-------+------ *)
  30. (* Picture        | XExt   | YExt  |objekte|unitlen|       |       |       *)
  31. (* Text           |        |       |       |       |AlignFl|       |Textlen*)
  32. (* Line           |        |       |       |       |       |       |       *)
  33. (* Arrow          |        |       |       |       |       |       |       *)
  34. (* Circle         | Radius |       |       |       |       |       |       *)
  35. (* Disk           | Radius |       |       |       |       |       |       *)
  36. (* Oval           | Radius | Posit.|       |       |       |       |       *)
  37. (* Filledbox      | XExt   | XExt  |       |       |       |       |       *)
  38. (* Ovalbox        | XExt   | YExt  |       |       |       |       |       *)
  39. (* Framebox       | XExt   | YExt  |Textpos|MBxFlag|AlignFl|       |Textlen*)
  40. (* Dashbox        | XExt   | Yext  |Textpos|       |AlignFl|       |Textlen*)
  41. (* Beziercurve    |  X2    |  Y2   |  X3   |  Y3   |Points |       |       *)
  42. (* Bezierellipse  |  X2    |  Y2   |  X3   |  Y3   |Points |       |       *)
  43. (* EpicSolidLine  | Pts-1  |       |       |       |       |       |MarkTL *)
  44. (* EpicDottedLine | Pts-1  |       |       |       |       |       |   "   *)
  45. (* EpicDashedLine | Pts-1  |       |       |       |       |       |   "   *)
  46. (* EpicGrid       | Xext   | YExt  |DeltaX |DeltaY |       |       |       *)
  47. (* Arc            | Radius |StartA.|DeltaA.|       |       |       |       *)
  48. (* Spline         | Pts-1  |       |       |       |       |       |       *)
  49. (* Ellipse        | XRadius|YRadius|StartA.|DeltaA.|       |       |       *)
  50.  
  51. CONST FullCSName = TRUE; (* Beim special-Befehl Pfad mit übergeben    *)
  52. CONST Clever     = TRUE; (* Doppelpfeile durch einfaches hinzufügen   *)
  53.                          (* einer zweiten Pfeilspitze erzeugen (TRUE) *)
  54.                          (* oder durch 2 Pfeile darstellen (FALSE)?   *)
  55.  
  56. VAR OutLine, Part,
  57.     CSName,
  58.     String         : ARRAY [0..255] OF CHAR ;
  59.     Handle,
  60.     i , j          : INTEGER ;
  61.     Object         : ObjectPtrTyp ;
  62.     Width          : INTEGER ;  (* Liniendicke *)
  63.     TextOnly       : BOOLEAN ;
  64.     Flag1          : BOOLEAN ;
  65.     Flag2          : BOOLEAN ;
  66.     UseCSspecial,
  67.     UseEEPiC       : BOOLEAN ;
  68.     CompileEm      : ARRAY specialformat,
  69.                            DrawObjectTyp OF BOOLEAN;
  70.  
  71. (**
  72. PROCEDURE AppendChar(c : CHAR; VAR target : ARRAY OF CHAR);
  73. VAR temp : ARRAY [0..1] OF CHAR;
  74. BEGIN
  75.   temp[0] := c;
  76.   temp[1] := 0C;
  77.   MagicStrings.Append(temp, target);
  78. END AppendChar;
  79. **)
  80.  
  81. (**********************************************************)
  82.  
  83. PROCEDURE Position ( Pos : INTEGER ; VAR Str : ARRAY OF CHAR ) ;
  84.  
  85. BEGIN
  86.   CASE VAL(TextPosTyp, Pos) OF
  87.     LeftTop  : MagicStrings.Assign ( '[tl]', Str); |
  88.     Left     : MagicStrings.Assign ( '[l]', Str); |
  89.     LeftBot  : MagicStrings.Assign ( '[bl]', Str); |
  90.     Top      : MagicStrings.Assign ( '[t]', Str); |
  91.     Bottom   : MagicStrings.Assign ( '[b]', Str); |
  92.     RightTop : MagicStrings.Assign ( '[tr]', Str); |
  93.     Right    : MagicStrings.Assign ( '[r]', Str); |
  94.     RightBot : MagicStrings.Assign ( '[br]', Str); |
  95.   ELSE
  96.     MagicStrings.Assign ( '', Str);
  97.   END;
  98. END Position ;
  99.  
  100. PROCEDURE BasicGetPut(x, y : INTEGER);
  101. BEGIN
  102.   OutLine := "\put(,)" ; (* Anfangskoordinaten *)
  103.   Variablen.SimpleValueToStr ( y , String ) ;
  104.   MagicStrings.Insert ( String , OutLine , 6 ) ;
  105.   Variablen.SimpleValueToStr ( x , String ) ;
  106.   MagicStrings.Insert ( String , OutLine , 5 ) ;
  107. END BasicGetPut;
  108.  
  109. PROCEDURE Basic10GetPut(x, y : MagicSys.lINTEGER);
  110. BEGIN
  111.   OutLine := "\put(,)" ; (* Anfangskoordinaten *)
  112.   Variablen.SimpleValue10ToStr ( y , String ) ;
  113.   MagicStrings.Insert ( String , OutLine , 6 ) ;
  114.   Variablen.SimpleValue10ToStr ( x , String ) ;
  115.   MagicStrings.Insert ( String , OutLine , 5 ) ;
  116. END Basic10GetPut;
  117.  
  118. PROCEDURE GetPut ( Object : ObjectPtrTyp ) ;
  119. BEGIN
  120.   BasicGetPut(Object^.Code[1], Object^.Code[2]);
  121. END GetPut;
  122.  
  123. PROCEDURE GetText(    Object : ObjectPtrTyp;
  124.                   VAR result : ARRAY OF CHAR) ;
  125. VAR temp   : ARRAY [0..255] OF CHAR;
  126.     insert : ARRAY [0..19] OF CHAR;
  127.     align  : INTEGER;
  128.     cr     : BOOLEAN;
  129.     i, j, len : INTEGER;
  130. BEGIN
  131.   temp  := '';
  132.   cr    := FALSE;
  133.   len   := Object^.Code[9];
  134.   align := Object^.Code[7];
  135.   FOR i := 0 TO len-1 DO
  136.     temp [ i ] := Object^.CPtr^ [ i ] ;
  137.   END ;
  138.   temp [ len ] := 0C ;
  139.   FOR i:=0 TO len-2 DO
  140.     IF (temp[i]='\') AND (temp[i+1]='\') THEN
  141.       cr := TRUE;
  142.     END;
  143.   END;
  144.   IF cr THEN
  145.     insert := '';
  146.     CASE align OF
  147.      0: (* center     *) insert := '\shortstack{'; |
  148.      1: (* leftalign  *) insert := '\shortstack[l]{'; |
  149.      2: (* rightalign *) insert := '\shortstack[r]{'; |
  150.      ELSE
  151.     END;
  152.     IF insert[0]<>0C THEN
  153.       MagicStrings.Insert(insert, temp, 0);
  154. (*      AppendChar ('}', temp);*)
  155.       MagicStrings.Append('}', temp);
  156.     END;
  157.   END;
  158.   MagicStrings.Assign ( temp, result);
  159. END GetText;
  160.  
  161. PROCEDURE ArrowHead(x1, y1, x2, y2 : INTEGER;
  162.                     start, end     : BOOLEAN);
  163. (* LaTeX erlaubt die Steigungspaare von (-4..+4,-4..+4) wobei
  164.    die Werte keinen gemeinsamen Teiler haben dürfen *)
  165. VAR mx, my : INTEGER;
  166.     dx, dy : INTEGER;
  167.     i, j   : INTEGER;
  168.     a1, e1,
  169.     a2, e2 : INTEGER;
  170.     slope  : ARRAY [-4..+4],[-4..+4] OF LONGREAL;
  171.     testslope : LONGREAL;
  172.     delta     : LONGREAL;
  173. BEGIN
  174.   FOR mx := -4 TO 4 DO
  175.     FOR my := -4 TO 4 DO
  176.       IF mx<>0 THEN
  177.         slope[mx,my] := MathLib0.real(my) / MathLib0.real(mx) ;
  178.        ELSE
  179.         IF mx>=0 THEN
  180.           slope[mx,my] :=  +9999.99
  181.          ELSE
  182.           slope[mx,my] :=  -9999.99
  183.         END;
  184.       END;
  185.     END;
  186.   END;
  187.  
  188.   (* Also: zunaechst einmal Steigung bestimmen *)
  189.   dx := x2 - x1;
  190.   dy := y2 - y1;
  191.   IF dx<0 THEN
  192.     a1 := -4;
  193.     e1 := 0;
  194.    ELSE
  195.     a1 := 0;
  196.     e1 := +4;
  197.   END;
  198.   IF dy<0 THEN
  199.     a2 := -4;
  200.     e2 := 0;
  201.    ELSE
  202.     a2 := 0;
  203.     e2 := +4;
  204.   END;
  205.   (* Sonderfälle abfangen *)
  206.   IF dx = 0 THEN
  207.     mx := 0;
  208.     IF dy<0 THEN
  209.       my := -1;
  210.      ELSE
  211.       my := +1;
  212.     END;
  213.    ELSIF dy = 0 THEN
  214.     my := 0;
  215.     IF dx<0 THEN
  216.       mx := -1;
  217.      ELSE
  218.       mx := +1;
  219.     END;
  220.    ELSE
  221.     testslope := MathLib0.real(dy) / MathLib0.real(dx);
  222.     (* So welcher Wert liegt nahe *)
  223.     mx := 0;
  224.     my := 0;
  225.     delta := 9999.99;
  226.     FOR i:=a1 TO e1 DO
  227.       FOR j:=a2 TO e2 DO
  228.         IF ABS(slope[i,j] - testslope)<delta THEN
  229.           delta := ABS(slope[i,j] - testslope);
  230.           mx := i;
  231.           my := j;
  232.         END;
  233.       END;
  234.     END;
  235.   END;
  236.   IF NOT ((mx=0) AND (my=0)) THEN
  237.     (* So jetzt eventuell Bruch reduzieren *)
  238.     IF (mx<>0) AND (my<>0) THEN
  239.       WHILE ((mx MOD 2) = 0) AND ((my MOD 2) =0) DO
  240.         (* Es können nur Vielfache von 2 sein *)
  241.         mx := mx DIV 2;
  242.         my := my DIV 2;
  243.       END;
  244.     END;
  245.   END;
  246.   IF start THEN
  247.     BasicGetPut(x1, y1);
  248.     Part := '{\vector(,){0}}';
  249.     Variablen.NumberToStr ( -my , String ) ;
  250.     MagicStrings.Insert ( String , Part , 10 ) ;
  251.     Variablen.NumberToStr ( -mx , String ) ;
  252.     MagicStrings.Insert ( String , Part , 9 ) ;
  253.     MagicStrings.Append ( Part , OutLine ) ;
  254.     WriteLn ( Handle